home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / MARKST.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  4.7 KB  |  162 lines
  1.       SUBROUTINE MARKST(OPTION,IERR)
  2. *-----------------------------------------------------------------------
  3. *   
  4. * in SSTA, suppresses multiple blanks outside strings, puts strings 
  5. * in special characters,
  6. * '{' and '}'. strings may be either ...H, or be
  7. * included in single or double quotes.  
  8. *   
  9. *--- input  
  10. *    OPTION          (character) 'FULL' or 'PART' to extract
  11. *                    all, or just start (up to first bracket)   
  12. *    NCHST           number of ch. in SSTA  
  13. *   
  14. *--- output 
  15. *    IERR          = 0 if everything OK, =1 if illegal characters found,
  16. *                  or unclosed string.  
  17. *    SSTA            COMMON/ALCAZA/  FORTRAN fields 7-72 of SIMA
  18. *    NCHST           COMMON/STATE/  last non-blank in SSTA  
  19. *   
  20. *   
  21. *-----------------------------------------------------------------------
  22.       include 'PARAM.h' 
  23.       include 'ALCAZA.h' 
  24.       include 'CURSTA.h' 
  25.       CHARACTER STEMP*1,SKEEP*1,SDUM*100,OPTION*4   
  26.       LOGICAL POSS,SPOSS,PARTFL,LASTBL  
  27.       include 'CONVEX.h' 
  28.       PARTFL=OPTION.EQ.'PART'   
  29.       NCH=0 
  30.       NDUM=0
  31.       ISKIP=0   
  32. *--- ISKIP = 0      outside string  
  33. *          = -1     inside hollerith string (nH...) 
  34. *          = +1     inside character string (' or ")
  35.       NHOLL=0   
  36.       IERR=0
  37.       POSS=.FALSE.  
  38.       SPOSS=.FALSE. 
  39.       STEMP=' ' 
  40.       J=0   
  41.    10 CONTINUE  
  42.       J=J+1 
  43.       IF (J.GT.NCHST) GOTO 20   
  44.       LASTBL=STEMP.NE.' '   
  45.       STEMP=SSTA(J:J)   
  46.       IF (PARTFL)  THEN 
  47.          IF (STEMP.EQ.'(')GOTO 30   
  48.       ENDIF 
  49.       IF (INDEX(SPILL,STEMP).NE.0)  THEN
  50. *--- illegal character  
  51.          GOTO 40
  52.       ENDIF 
  53.       IF (ISKIP.EQ.0)  THEN 
  54. *--- not in string  
  55.          IF (STEMP.EQ.' ')  THEN
  56.             IF (LASTBL)  THEN   
  57.                NCH=NCH+1
  58.                SSTR(NCH:NCH)=' '
  59.             ENDIF   
  60.          ELSEIF (NUMCH(STEMP))  THEN
  61.             IF (POSS)  THEN 
  62. *--- count for ..H may start or continue
  63.                IF (NHOLL.LT.10000) NHOLL=10*NHOLL+ICVAL(STEMP)-ICVAL('0'
  64.      +         )
  65.                NDUM=NDUM+1  
  66. *--- buffer digits  
  67.                SDUM(NDUM:NDUM)=STEMP
  68.             ELSE
  69.                NCH=NCH+1
  70.                SSTR(NCH:NCH)=STEMP  
  71.             ENDIF   
  72.          ELSEIF (ALPHCH(STEMP))  THEN   
  73.             IF (NDUM.EQ.0)  THEN
  74. *--- no digits (= holl. count ) buffered
  75.                POSS=.FALSE. 
  76.                NCH=NCH+1
  77.                SSTR(NCH:NCH)=STEMP  
  78.             ELSE
  79.                IF (STEMP.EQ.'H')  THEN  
  80.                   NCH=NCH+1 
  81.                   SSTR(NCH:NCH)='{' 
  82.                   ISKIP=-1  
  83.                   SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM)  
  84.                   NCH=NCH+NDUM+1
  85.                   SSTR(NCH:NCH)=STEMP   
  86.                ELSE 
  87. *--- other alphabetic ch. than H
  88.                   POSS=.FALSE.  
  89.                   NHOLL=0   
  90.                   SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM)  
  91.                   NCH=NCH+NDUM+1
  92.                   SSTR(NCH:NCH)=STEMP   
  93.                ENDIF
  94.                NDUM=0   
  95.             ENDIF   
  96.          ELSE   
  97. *--- special character  
  98.             SPOSS=SPOSS.OR.STEMP.NE.'*' 
  99. *--- holl. count cannot start after '*' 
  100.             POSS=SPOSS  
  101.             IF (NDUM.NE.0)  THEN
  102.                SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM) 
  103.                NCH=NCH+NDUM 
  104.                NDUM=0   
  105.             ENDIF   
  106.             NHOLL=0 
  107.             IF (STEMP.EQ.''''.OR.STEMP.EQ.'"')  THEN
  108.                ISKIP=1  
  109.                SKEEP=STEMP  
  110.                NCH=NCH+1
  111.                SSTR(NCH:NCH)='{'
  112.             ENDIF   
  113.             NCH=NCH+1   
  114.             SSTR(NCH:NCH)=STEMP 
  115. *--- following ENDIF for IF(STEMP.EQ.' ')  THEN  etc.   
  116.          ENDIF  
  117.       ELSEIF (ISKIP.LT.0)  THEN 
  118. *--- inside a holl. string  
  119.          NHOLL=NHOLL-1  
  120.          NCH=NCH+1  
  121.          SSTR(NCH:NCH)=STEMP
  122.          IF (NHOLL.EQ.0)  THEN  
  123. *--- end of holl. string reached
  124.             ISKIP=0 
  125.             NCH=NCH+1   
  126.             SSTR(NCH:NCH)='}'   
  127.          ENDIF  
  128.       ELSE  
  129. *--- ISKIP GT 0 
  130.          IF (STEMP.EQ.''''.AND.SSTA(J+1:J+1).EQ.''''.AND.J.LT.NCHST)
  131.      +   THEN   
  132.             SSTR(NCH+1:NCH+2)=SSTA(J:J+1)   
  133.             J=J+1   
  134.             NCH=NCH+2   
  135.          ELSEIF (SKEEP.EQ.STEMP)  THEN  
  136. *--- end of string  
  137.             ISKIP=0 
  138.             NCH=NCH+1   
  139.             SSTR(NCH:NCH)=STEMP 
  140.             NCH=NCH+1   
  141.             SSTR(NCH:NCH)='}'   
  142.          ELSE   
  143.             NCH=NCH+1   
  144.             SSTR(NCH:NCH)=STEMP 
  145.          ENDIF  
  146.       ENDIF 
  147.       GOTO 10   
  148.    20 CONTINUE  
  149.       IF(NDUM.GT.0)  THEN   
  150. *--- still some lonely digits hanging around
  151.          SSTR(NCH+1:NCH+NDUM)=SDUM(:NDUM)   
  152.          NCH=NCH+NDUM   
  153.       ENDIF 
  154.       IF (ISKIP.NE.0) GOTO 40   
  155.    30 NCHST=NCH 
  156.       SSTA(:NCH)=SSTR(:NCH) 
  157.       GOTO 999  
  158.    40 CONTINUE  
  159. *--- illegal - either unclosed string, or illegal character 
  160.       IERR=1
  161.   999 END   
  162.